Optional Spritesets.f

Requires Stacks.f
Requires Tools.f
Requires KAGI.f
Requires Dorothy.f

Only Forth Definitions



type: spritedef
   short.field firstframe
   13 byte.field[] name
end-type

\ Read-only form - disposes names and trailing blank sprites and frames
Image-based extend: spriteset
   subimage.pointer frames
   spritedef.pointer sprites \ optional
end-type

spriteset extend: modifiable-spriteset
   1024 subimage.field[] frametable
   512 spritedef.field[] spritetable
end-type

: /fill   here over allot swap 255 fill ;

\ Spriteset File Format:  headersize , #frames , #sprites , 0 , data ...

: get-spriteset-file-size  ( filename count -- #frames #sprites )
   pad slurp  pad cell+ @+ swap @ ;

method: spriteset.load  ( filename count spriteset -- )
   pad slurp
   pad dup @ +  frames  pad cell+ @  subimage.*  move
   pad dup @ +  pad cell+ @ subimage.* +  sprites  pad cell+ cell+ @  spritedef.* move
   ;

method: spriteset.construct  ( filename count spriteset -- <name> )
   2dup get-spriteset-file-size   ( #frames #sprites )
   here ( spritetable ) to sprites >r  spritedef.* /fill
   here ( frametable ) to frames >r  subimage.* /fill
   r> r> load ;

\ Frames
macro: spriteset.next-frame   spriteset.frames.[].next.@ ;

macro: spriteset.first-frame  spriteset.sprites.[].firstframe.@ ;

method: spriteset.[]   (  sprite#  index  spriteset -- frame# )
   first-frame  swap  0 ?do  next-frame loop ;

\ LAST-FRAME - this could be used to detect the loop point and we could store it in the sprite, after we are done with the name
\ If a sprite is non looping, last frame jumps to -1, if looping, last frame jumps to start of loop.
1000 Stack: framestack

: (in-framestack)
   framestack.count 0 ?do @+ third = if unloop 2drop true exit then loop 2drop false ;

method: spriteset.last-frame  (  sprite#  spriteset -- frame# )
   framestack clear-stack
   first-frame begin
      dup framestack.push
      dup next-frame dup  0< if drop exit then
      dup (in-framestack) if drop exit then
      nip
   again ;

